Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue34/timetrav/BaseDate.pas

Pascal/Delphi Source File | 1998-03-25 | 22.9 KB | 641 lines

unit BaseDate;
interface
uses classes, sysutils, calConstants;

ResourceString
  cNoSuchMonthIndex = 'Month # %d does not exist';
  cNoSuchDayIndex = 'Day # %d does not exist';
  cNoLeapYearFunction = 'No Leap Year Formula';
  cNoEncodeDateProc = 'No Encode Date Proc';
  cNoDecodeDateProc = 'No Decode Date Proc';
  cMJDOutsideTDateTimeRange = 'MJD outside TDateTime Range';
  cDayOutOfMonthRange = 'Day out of month''s range';
  cMonthOutOfYearRange = 'Month out of year''s range';
  c1752isChangeOver = '3-13 Sept, 1752, do not exist';
  cOutOfYearRange = 'Only good for %s BC to %s AD';
  cOutOfMJDRange = 'MJD limited to %n through %n';

Type
  EMonthList = exception;
  EDayList = exception;
  ENoLeapYearFunction = exception;
  ENoEncodeDateProc = exception;
  ENoDecodeDateProc = exception;
  EMJDOutsideTDateTimeRange = exception;
  eDayOutOfMonthRange = exception;
  eMonthOutOfYearRange = exception;
  eChangeOverError = exception;
  eOutOfYEarRange = exception;
  eOutOfMJDRange = exception;

  TCalendarDate = record
                    Year, Month, Day : integer;
                    end;
  TMJD = double;  // this in effect replaces TDateTime
  TLinkDate = record  //a date in the current calendar and its MJD equivalent
                Date : tCalendarDate;
                MJD : TMJD;
                end;
  TGregorianChangeRec = record
                LastMJD : TMJD;        // Last Date in MJD value
                LastDate : tCalendarDate;  // Last date in old system
                Adjustment : integer;  // days +/- to add/delete to/from calendar
                                       // day of month/year + adjustment = first date Gregorian system in use
                end;
  TmonthStructure = class
    private
      fNumDays : integer;
      fName : string;
      fMissingDaysStart,
      fMissingDaysEnd : integer;
    public
      constructor BuildMonth(const aName : string; const aNumDays, StartMissing, EndMissing : integer);
      function HasMissingDays(var First, Last : integer): boolean;
      Property NumDays : integer read fNumDays write fNumdays;
      property Name : string read fName write fName;
      Property FirstMissingDay : integer read fMissingDaysStart write fMissingDaysStart;
      Property LastMissingDay : integer read fMissingDaysEnd write fMissingDaysEnd;
    end;

  TYearStructure = class
    private
      fNumMonths : integer;
      fMonthList : tlist;
      procedure GrowMonthList;
    protected
      function GetMonthName(index : integer): string;
      procedure SetMonthName(index : integer; aName : string);
      function GetMonthLen(index : integer): integer;
      procedure SetMonthLen(index : integer; aLen : integer);
      function GetMonthStruc(index : integer): tMonthStructure;
      procedure setMonthStruc(index : integer; aStruc : tMonthStructure);
    public
      constructor create;
      destructor destroy; override;
//      Procedure SwapMonths(index : integer; var WithMonth : tMonthStructure);
      property NumMonths : integer read fNumMonths write fNumMonths;
      property MonthName[index : integer] : string read getMonthName write setMonthName;
      Property MonthLen[index : integer] : integer read getMonthLen write setMonthLen;
      Property MonthObj[index : integer] : tMonthStructure read getMonthStruc write setMonthStruc;
      end;

//  TLeapYearRule = function(aYear : integer): boolean of object;
//  TEncodeDateProc = procedure(var MJD : TMJD; const aYear, aMonth, aDay :integer) of object;
//  TDecodeDateProc = procedure(const MJD : TMJD; var aYear, aMonth, aDay :integer) of object;

  TCalendarDef = class
   Private
    fName : string;                  // name, e.g. English, Swedish, Roman
    fDate : TLinkDate;               // Date we are currently working with
    fAstro : boolean;                // set true to insert a year zero between 1BC and 1AD
    fYearDef : TYearStructure;
    fDayName : TStringlist;          // count is the number of days per week
    fDayStart : double;              // 0.0 = midnight, 0.5 = noon, etc.
//    fIsLeapYear : tLeapYearRule;
//    fOnEncode : tEncodeDateProc;
//    fOnDecode : tDecodeDateProc;
    fAlignmentDate : TLinkDate;
    fNameOfPreviousSystem : string;   // name of calendar system before fGregorian date
    fGregorianDate : TGregorianChangeRec;
    fSwitchOnChangeDate : boolean;    // true means use previous system for dates before Gegorian dates
   Protected
    function getDate : TLinkDate; virtual;
    procedure setDate(avalue : tLinkDate); virtual;
    function getDaysPerYear : cardinal; virtual;
//    procedure setDaysPerYear(avalue : cardinal); virtual;
    function getNumberOfMonths : integer; virtual;
    procedure setNumberOfMonths(avalue : integer); virtual;
    function getMonthName(index: integer): string; virtual;
    procedure setMonthName(index : integer; aName : string);  virtual;
    function getMonthLength(index : integer): cardinal; virtual;
    procedure setMonthLength(index : integer; aValue : cardinal); virtual;
    function getDayName(index : integer): string; virtual;
    procedure setDayName(index : integer; aName : string); virtual;
    function getDayStart: double; virtual;
    procedure setDayStart(avalue : double); virtual;
//    Procedure fEncodeDate(var MJD : TMJD; const aYear, aMonth, aDay :integer); virtual;  abstract;
//    Procedure fDecodeDate(const MJD : TMJD; var aYear, aMonth, aDay :integer); virtual;  abstract;
    function getAlignmentDate : tLinkDate; virtual;
    procedure setAlignmentDate(avalue : tLinkDate); virtual;
    function getChangeDate : TGregorianChangeRec; virtual;
    procedure setChangeDate(avalue : TGregorianChangeRec); virtual;

    Property CalendarName : string read fName write fName;
    Property OldCalendarSystemName : string read fNAmeOfPreviousSystem write fNameOfPreviousSystem;
    Property ShowPreviousDatesInPreviousSystem : boolean read fSwitchOnChangeDate write fSwitchOnChangeDate;
//    Property EncodeDateProc : tEncodeDateProc read fOnEncode write fOnEncode;
//    Property DecodeDateProc : tDecodeDateProc read fOnDecode write fOnDecode;
//    Property LeapYearRule : tLeapYearRule read fIsLeapYear write fIsLeapYear;
    Property Astro : boolean read fAstro write fAstro default false;
    Property DaysPerYear : cardinal read GetDaysPerYear; // write SetDaysPerYear;
    Property NumberOfMonths : integer read getNumberOfMonths write setNumberOfMonths;
    Property MonthName[index : integer] : string read getMonthName write setMonthName;
    Property MonthLength[index : integer] : cardinal read getMonthLength write setMonthLength;
    Property DayName[index : integer]: string read getDayName write setDayName;
    Property DayStart: double read getDayStart write setDayStart;
    Property AlignmentDate : tLinkDate read getAlignmentDate write setAlignmentDate;
    Property ChangeDate : TGregorianChangeRec read getChangeDate write setChangeDate;
    Property YearDef : tYearStructure read fYearDef;
    //    Property DayOfWeek: integer read GetDayOfWeek;
  Public
    constructor create; virtual;
    destructor destroy; override;
    function GetDayOfWeek(MJD : tMJD) : integer; virtual;
    Function IsLeapYear(aYear : integer): boolean; virtual; abstract;
    Function EncodeDate(const aYear, aMonth, aDay :integer): tMJD; virtual;  abstract;
    Function DecodeDate(const MJD : TMJD): tCalendarDate; virtual; abstract;
    Function MSDatefromMJD(const MJD : TMJD): tDateTime; virtual; abstract;
    Function MJDfromMSDate(const aDateTime : tDateTime): TMJD; virtual; abstract;
   end;

  TEnglishCalendar = class(tCalendarDef)
   Private
     fSeptember1752,
     fNormalSeptember : tMonthStructure;
   Protected
    function getDate : TLinkDate; override;
    procedure setDate(aValue : tLinkDate); override;
//    Property EncodeDateProc : tEncodeDateProc read fOnEncode write fOnEncode;
//    Property DecodeDateProc : tDecodeDateProc read fOnDecode write fOnDecode;
//    Property LeapYearRule : tLeapYearRule read fIsLeapYear write fIsLeapYear;
//    Procedure fEncodeDate(var MJD : TMJD; const aYear, aMonth, aDay :integer); override;
//    Procedure fDecodeDate(const MJD : TMJD; var aYear, aMonth, aDay :integer); override;
  Public
    Constructor create; override;
    Destructor destroy; override;
    Function IsLeapYear(aYear : integer): boolean; override;
    Function EncodeDate(const aYear, aMonth, aDay :integer): tMJD; override;
    Function DecodeDate(const MJD : TMJD): tCalendarDate; override;
    Function MSDatefromMJD(const MJD : TMJD): tDateTime; override;
    Function MJDfromMSDate(const aDateTime : tDateTime): TMJD; override;

    Property CalendarName;
    Property OldCalendarSystemName;
    Property ShowPreviousDatesInPreviousSystem;
    Property Astro;
    Property DaysPerYear;
    Property NumberOfMonths;
    Property MonthName;
    Property MonthLength;
    Property DayName;
    Property DayStart;
    Property AlignmentDate;
    Property ChangeDate;
    Property YearDef;
    end;

Function ISOStdDateFormat(const ayear, aMonth, aDay : integer): integer;

implementation

Function ISOStdDateFormat(const ayear, aMonth, aDay : integer): integer;
var temp : string;
begin
  temp := IntToStr(aYear)+format('%2.2d',[aMonth])+format('%2.2d',[aday]);
  result := StrToInt(temp);
end;



Function IsJulianLeapYear(const aYear : integer): boolean;
begin
  Result := (AYear mod 4 = 0);
end;

function IsGregorianLeapYear(const AYear: Integer): Boolean;
begin
  Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
end;

{=================  TMonthStructure ============================}

constructor tMonthStructure.BuildMonth(const aName : string; const aNumDays, StartMissing, EndMissing : integer);
begin
  inherited create;
  fName := aName;
  fNumDays := aNumDays;
  fMissingDaysStart := StartMissing;
  fMissingDaysEnd := EndMissing;
end;

function TMonthStructure.HasMissingDays(var First, Last : integer): boolean;
begin
  if fMissingDaysStart = 0
    then result := false
    else begin
      result := true;
      First := fMissingDaysStart;
      Last := fMissingDaysEnd;
      end;
end;

{=================== TYearStructure ===================}

constructor TYearStructure.create;
var i : integer;
begin
  inherited create;
  fMonthList := tlist.create;
  fMonthList.capacity := 13;
  for i := 1 to 13 do
    fmonthList.add(nil);
end;

destructor TYearStructure.destroy;
var i : integer;
begin
  for i := 0 to fMonthList.count - 1 do
    TMonthStructure(fMonthList.items[i]).free;
  fMonthList.free;
  inherited destroy;
end;

procedure tYearStructure.growMonthList;
begin
  fMonthList.add(nil);
  fMonthList.add(nil);
end;

{Procedure TYearStructure.SwapMonths(index : integer; var WithMonth : tMonthStructure);
var temp : tMonthStructure;
begin
  if fMonthList.capacity < index then GrowMonthList;
  temp := MonthObj[index];
  fMonthList.items[index-1] := nil;
  MonthObj[index] := WithMonth;
  WithMonth := temp;
end;}

function TYearStructure.GetMonthName(index : integer): string;
var offset : integer;
begin
  offset := index-1;
  result := TMonthStructure(fMonthList.items[offset]).name;
end;

procedure TYearStructure.SetMonthName(index : integer; aName : string);
var offset : integer;
begin
  if fMonthList.capacity < index then GrowMonthList;
  offset := index - 1;
  TMonthStructure(fMonthList.items[offset]).name := aName;
end;

function TYearStructure.GetMonthLen(index : integer): integer;
var offset : integer;
begin
  offset := index-1;
  result := TMonthStructure(fMonthList.items[offset]).numdays;
end;

procedure TYearStructure.SetMonthLen(index : integer; aLen : integer);
var offset : integer;
begin
  if fMonthList.capacity < index then GrowMonthList;
  offset := index - 1;
  TMonthStructure(fMonthList.items[offset]).NumDays := aLen;
end;

function TYearStructure.GetMonthStruc(index : integer): tMonthStructure;
var offset : integer;
begin
  offset := index-1;
  result := TMonthStructure(fMonthList.items[offset]);
end;

procedure TYearStructure.setMonthStruc(index : integer; aStruc : tMonthStructure);
var offset : integer;
begin
  if fMonthList.capacity < index then GrowMonthList;
  offset := index - 1;
  if fMonthList.items[offset] <> nil
    then fMonthList.items[offset] := nil;
  fMonthList.items[offset] := astruc;
end;



{=============== TCalendarDef ==================}

Constructor TCalendarDef.Create;
begin
  inherited create;
  fYearDef := TYearStructure.create;
  fDayName := tstringlist.create;
end;

Destructor TCalendarDef.destroy;
begin
  fYearDef.free;
  fDayName.free;
  inherited destroy;
end;

function TCalendarDef.getDate : TLinkDate;
begin result := fDate end;

procedure TCalendarDef.setDate(avalue : tLinkDate);
begin fDate := avalue; end;

function TCalendarDef.getDaysPerYear : cardinal;
var i : integer;
begin
  result := 0;
  for i := 1 to fYearDef.NumMonths do
     result := result + fYearDef.MonthLen[i];
end;

//procedure TCalendarDef.setDaysPerYear(avalue : cardinal);
//begin  fDaysPerYear := avalue end;

function TCalendarDef.getNumberOfMonths : integer;
begin result := fYearDef.NumMonths; end; //MonthNameLength.count; end;

procedure TCalendarDef.setNumberOfMonths(avalue : integer);
begin  fYearDef.NumMonths := aValue; end; //MonthNameLength.capacity := aValue end;

function TCalendarDef.getMonthName(index: integer): string;
begin
  if (index < fYearDef.NumMonths) and (index > 0)
    then result := fYearDef.MonthName[index]
    else raise EMonthList.create(format(cNoSuchMonthIndex, [index]));
end;

procedure TCalendarDef.setMonthName(index : integer; aName : string);
begin
  if (index < fYearDef.NumMonths) and (index > 0)
    then fYEarDef.MonthName[index] := aName
    else raise EMonthList.create(format(cNoSuchMonthIndex, [index]));
end;

function TCalendarDef.getMonthLength(index : integer): cardinal;
begin
  if (index < fYearDef.NumMonths) and (index > 0)
    then result := fYearDef.MonthLen[index] //LongInt(fMonthNameLength.objects[index])
    else raise EMonthList.create(format(cNoSuchMonthIndex, [index]));
end;

procedure TCalendarDef.setMonthLength(index : integer; aValue : cardinal);
begin
  if (index < fYearDef.NumMonths) and (index > 0)
    then fYearDef.MonthLen[index] := aValue //fMonthNameLength.objects[index] := Ptr(index)
    else raise EMonthList.create(format(cNoSuchMonthIndex, [index]));
end;

function TCalendarDef.getDayName(index : integer): string;
begin
  if (index < fDayName.count) and (index > -1)
    then result := fDayName[index]
    else raise EDayList.create(format(cNoSuchDayIndex, [index]));
end;

procedure TCalendarDef.setDayName(index : integer; aName : string);
begin
  if (index < fDayName.count) and (index > -1)
    then fDayName[index] := aName
    else raise EDayList.create(format(cNoSuchDayIndex, [index]));
end;

function TCalendarDef.getDayStart: double;
begin result := fDayStart end;

procedure TCalendarDef.setDayStart(avalue : double);
begin fDayStart := avalue end;

function TCalendarDef.getAlignmentDate : tLinkDate;
begin result := falignmentDate end;

procedure TCalendarDef.setAlignmentDate(avalue : tLinkDate);
begin fAlignmentDate := avalue; end;

function tCalendarDef.getChangeDate : TGregorianChangeRec;
begin result := fGregorianDate; end;

procedure tCalendarDef.setChangeDate(avalue : TGregorianChangeRec);
begin fGregorianDate := aValue; end;

Function tCalendarDef.GetDayOfWeek(MJD : tMJD): integer;
begin
  result := (trunc(MJD)[phone]) mod 7 +1;
//  trunc(mjd) mod 7; // + 1;
end;

{================= English Calendar ==================}

const
  cEnglishLinkDate : tLinkDate = (Date: (year: 1995; month : 10; day: 10); MJD: 50000);
  cEnglishChangeDate : tGregorianChangeRec = (LastMJD : cLastMJDEnglish; LastDate: (year: 1752; month: 9; day: 13); Adjustment: 11);
  cNormalMonthLengths : array[1..12] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

Constructor TEnglishCalendar.create;
var i : integer;
begin
  inherited create;
  SetAlignmentDate(cEnglishLinkDate);
  SetChangeDate(cEnglishChangeDate);
  FYearDef.NumMonths := 12;
  for i := 1 to 12 do
    FYearDef.MonthObj[i] := tMonthStructure.buildMonth(longMonthNames[i], cNormalMonthLengths[i], 0, 0);
  fSeptember1752 := tMonthStructure.buildMonth(LongmonthNames[9], 19, 3, 13);
  fNormalSeptember := tMonthStructure.buildMonth(LongmonthNames[9], 30,0,0);
  for i := 1 to 7 do
    FDayName.add(LongDayNames[i]);
  fSwitchOnChangeDate := true;
  fNameOfPreviousSystem := 'Julian';
  fName := 'English';
end;

Destructor TEnglishCalendar.destroy;
begin
  inherited destroy;
end;

Function TEnglishCalendar.IsLeapYear(aYear : integer): boolean;
begin
  if ShowPreviousDatesInPreviousSystem
    then begin
      if aYear < ChangeDate.LastDate.year
        then result := IsJulianLeapYear(aYear)
        else result := IsGregorianLeapYear(aYEar);
      if AYear = ChangeDate.LastDate.Year
           then fYearDef.MonthObj[9] := fSeptember1752
           else fYearDef.MonthObj[9] := fNormalSeptember;
      end
    else result := IsGregorianLeapYear(aYear);
  if result
    then fYearDef.MonthLen[2] := 29
    else fYearDef.MonthLen[2] := 28;  //fMonthNameLength.objects[1] := ptr(28);
end;

Function TEnglishCalendar.EncodeDate(const aYear, aMonth, aDay :integer): tMJD;
// aMonth is 1..12, aDay is 1..31
// this code is more or less a direct translation of Stockton's code in MJD_DATE.PAS
var iMJD : integer;
    ThisYear, ThisMonth : integer;
    J : byte;
  procedure Steps(const D, Y : longint); // Increase MJDy by steps of D per Y Years
  var x : integer;
  begin
    X := ThisYear div Y;
    Inc(iMJD, X*D);
    ThisYear := ThisYear mod Y;
  end;
begin
  IsLeapYear(aYear);
  if ShowPreviousDatesInPreviousSystem
    then if AYear = ChangeDate.LastDate.Year
           then begin
             fYearDef.MonthObj[9] := fSeptember1752;
             if (aMonth = 9) and (aDay in [3..13])
                then raise eChangeOverError.create(c1752IsChangeOver);
             end
           else fYearDef.MonthObj[9] := fNormalSeptember;
//  if (aday < 1) or (aday > fYearDef.MonthObj[aMonth].fNumDays)
//    then raise eDayOutOfMonthRange.create(cDayOutOfMonthRange);
  if (aMonth < 1) or (aMonth > fYearDef.NumMonths)
    then raise eMonthOutOfYearRange.create(cMonthOutOfYearRange);
  ThisMonth := aMonth;
  ThisYear := aYear;
  if aMonth < cBaseMo
    then begin
      Inc(ThisMonth, 12);
      Dec(ThisYear);
      end;
  if not Astro
    then if ThisYear < 1 then Inc(ThisYear) { No Year Zero } ;
  if (ThisYear < cBaseYr)
    then Raise eOutOfYEarRange.create(format(cOutOfYearRange, [abs(cBaseYr),abs(cBaseYr)]));
  ThisYear := ThisYear - cBaseYr ;
  if ShowPreviousDatesInPreviousSystem
    then If ISOStdDateFormat(aYear,aMonth,aday)
             < ISOStdDateFormat(ChangeDate.LastDate.Year, ChangeDate.LastDate.Month, ChangeDate.lastdate.day)
           then iMJD := -cJulnBias
           else begin
             iMJD := -cGregBias;
             Steps(cYrs400, 400) ;
             Steps(cYrs100, 100)
             end ;
  Steps(cYrs004,   4) ;
  Inc(iMJD, ThisYear*cYrs001) ;
  for J := cBaseMo to Pred(ThisMonth) do
    Inc(iMJD, cSpecialMonthsArray[J]);
  Result := iMJD + aDay;
end;

Function TEnglishCalendar.DecodeDate(const MJD : TMJD): tCalendarDate;
(*
// this code is derived from the example on page 13 of Numerical Recipes in Pascal
// and comes out 1 day too late...
var PureJ : integer;
    je, jd, jc, jb, jalpha, ja : integer;
const igreg = 2299161;
begin
  PureJ := trunc(MJD + cJDoffset);
  if pureJ >= igreg
    then begin
      jalpha := trunc(((PureJ - 1867216)-0.25)/36524.25);
      ja := PureJ + 1 + jalpha - trunc(0.25*jalpha);
      end
    else ja := PureJ;
  jb := ja + 1524;
  jc := trunc(6680.0+((jb-2439870)-122.1)/365.25);
  jd := 365*jc + trunc(0.25*jc);
  je := trunc((jb-jd) / 30.6001);
  result.day := jb - jd - trunc(30.6001 * je);
  result.month := je - 1;
  if result.month > 12
    then result.month := Result.month - 12;
  result.year := jc - 4715;
  if result.month > 2
    then result.year := result.year - 1;
  if result.year <= 0  // astro adjustment
     then result.year := result.year -1;
end;
*)
//this was my attempt to translate Stockton's code.  It gave me the correct year,
//but the month and day were way off.
var ThisYear, ThisMonth, thisDay : integer;
    iMJD : integer;
    T : longint ;
  // procedure YMDW(Cal : Calendar ; As : boolean ; MJDy : longint ;
  //  var Yr : integer ; var Mo, Dy : byte)
  procedure Moves(const D, Y, N : longint); // Reduce MJDy by up to N steps of D, counting in Yr
  var X : longint ;
  begin
    X := Pred(iMJD) div D;
    if X>N then Dec(X); { X:=N ? }
    Inc(ThisYear, X*Y);
    iMJD := iMJD - X*D
  end;

begin
{  if Cal=Civil then
    if MJDy>LastJulianMJD[ChangeD] then Cal := Gregorian else Cal := Julian ;
  Inc(MJDy, Bias[Cal]) ;}
  if ShowPreviousDatesInPreviousSystem
    then begin
      if MJD > cLastMJDEnglish
        then iMJD := Trunc(MJD) + cGregBias
        else iMJD := Trunc(MJD) + cJulnBias;
      end
    else iMJD := Trunc(MJD) + cGregBias;
{  if MJDy>longint(2)*(-BaseYr)*Succ(Yrs001) then InputError(232) ;}
  if (iMJD < 1) or (abs(iMJD) > 2*abs(cBaseYr)*Succ(cYrs001))
    then raise eOutOfMJDRange.create(format(cOutOfMJDRange, [1.0, 1.0*abs(cBaseYr)*Succ(cYrs001)]));
  ThisYear := cBaseYr;
  ThisMonth := cBaseMo;
  if MJD > cLastMJDEnglish
    then begin
      Moves(cYrs400, 400, MaxLongInt) ;
      Moves(cYrs100, 100, 3)
      end ;
  Moves(cYrs004,   4, MaxLongInt) ;
  Moves(cYrs001,   1, 3);
  // ThisYear close enough, now work on month
  // but I can't figure out what he's doing here...
  repeat
    T := iMJD - cSpecialMonthsArray[ThisMonth];
    if T < 1 then BREAK ;
    iMJD := T ;
    Inc(ThisMonth)
    until ThisMonth = cUltiMo;  {Feb is long enough} {but array isn' that big?}
  ThisDay := iMJD;
  if ThisMonth > 12
    then begin
      Dec(ThisMonth, 12);
      Inc(ThisYear)
      end;
  if not Astro then if ThisYear < 1 then Dec(ThisYear) { No Year Zero } ;
  IsLeapYear(ThisYear);  // make sure fYearDef has right months...
  result.year := ThisYear;
  result.month := ThisMonth;
  result.day := ThisDay;
end;

Function TEnglishCalendar.MSDatefromMJD(const MJD : TMJD): tDateTime;
begin
  result := Trunc(MJD) - cMJD10Oct1995 + cMS10Oct1995;
  if (result < cLowerTDateTime) or (result > cUpperTDateTime)
    then raise EMJDOutsideTDateTimeRange.create(cMJDOutsideTDateTimeRange);
end;

Function TEnglishCalendar.MJDfromMSDate(const aDateTime : tDateTime): TMJD;
begin
  result := Trunc(aDateTime) - cMS10Oct1995;
  result := result + cMJD10Oct1995;
end;

function TEnglishCalendar.getDate : TLinkDate;
begin
  result := fAlignmentDate;
end;

procedure TEnglishCalendar.setDate(aValue : tLinkDate);
begin

end;



end.